home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / INIT.R < prev    next >
Encoding:
Text File  |  1992-02-11  |  26.8 KB  |  1,128 lines
  1. /*
  2.  * File: init.r
  3.  * Initialization, termination, and such.
  4.  * Contents: read_hdr, init/icon_init, envset, env_err, env_int,
  5.  *  fpe_trap, inttrag, segvtrap, error, syserr, c_exit, err,
  6.  *  fatalerr, pstrnmcmp, datainit, [loadicode, savepstate, loadpstate]
  7.  */
  8.  
  9. #if !COMPILER
  10. #include "../h/header.h"
  11. #endif                    /* !COMPILER */
  12.  
  13. /*
  14.  * Prototypes.
  15.  */
  16.  
  17. hidden    novalue    env_err    Params((char *msg,char *name,char *val));
  18. FILE    *pathOpen    Params((char *fname, char *mode));    
  19.  
  20. /*
  21.  * The following code is operating-system dependent [@init.01].  Declarations
  22.  *   that are system-dependent.
  23.  */
  24.  
  25. #if PORT
  26.    /* probably needs something more */
  27. Deliberate Syntax Error
  28. #endif                    /* PORT */
  29.  
  30. #if AMIGA
  31. int chkbreak;                /* if nonzero, check for ^C */
  32. #endif                    /* AMIGA */
  33.  
  34. #if MSDOS
  35. #if HIGHC_386
  36. int _fmode = 0;            /* force CR-LF on std.. files */
  37. #endif                    /* HIGHC_386 */
  38. #endif                    /* MSDOS */
  39.  
  40. #if ARM || ATARI_ST || MACINTOSH || MVS || VM || OS2 || UNIX || VMS
  41.    /* nothing needed */
  42. #endif                    /* ARM || ATARI_ST || MACINTOSH ... */
  43.  
  44. /*
  45.  * End of operating-system specific code.
  46.  */
  47.  
  48. #if !COMPILER
  49. #ifdef MemMon
  50. extern char *monfname;            /* explicit -E value from iconx cmd */
  51. #endif                    /* MemMon */
  52. #endif                    /* !COMPILER */
  53.  
  54. #ifdef IconAlloc
  55. #define malloc mem_alloc
  56. #endif                    /* IconAlloc */
  57.  
  58. #if !COMPILER
  59. #define OpDef(p,n,s) int Cat(O,p) Params((dptr cargp));
  60. #include "../h/odefs.h"
  61. #undef OpDef
  62.  
  63. /*
  64.  * External declarations for operator blocks.
  65.  */
  66.  
  67. #passthru #ifdef MultiThread
  68. #passthru #define OpDef(f,nargs,sname)\
  69.      {\
  70.      T_Proc,\
  71.      Vsizeof(struct b_proc),\
  72.      Cat(O,f),\
  73.      nargs,\
  74.      -1,\
  75.      0,\
  76.      0,\
  77.      0,\
  78.      {{sizeof(sname)-1,sname}}},
  79. #passthru #else                    /* MultiThread */
  80. #passthru #define OpDef(f,nargs,sname)\
  81.      {\
  82.      T_Proc,\
  83.      Vsizeof(struct b_proc),\
  84.      Cat(O,f),\
  85.      nargs,\
  86.      -1,\
  87.      0,\
  88.      0,\
  89.      {{sizeof(sname)-1,sname}}},
  90. #passthru #endif                    /* MultiThread */
  91. #passthru static B_IProc(2) init_op_tbl[] = {
  92. #passthru #include "../h/odefs.h"
  93. #passthru   };
  94. #undef OpDef
  95. #endif                    /* !COMPILER */
  96. /*
  97.  * A number of important variables follow.
  98.  */
  99.  
  100. int line_info;             /* flag: line information is available */
  101. char *file_name = NULL;         /* source file for current execution point */
  102. int line_num = 0;         /* line number for current execution point */
  103. struct b_proc *op_tbl;           /* operators available for string invocation */
  104.  
  105. extern struct errtab errtab[];        /* error numbers and messages */
  106.  
  107. word mstksize = MStackSize;        /* initial size of main stack */
  108. word stksize = StackSize;        /* co-expression stack size */
  109.  
  110. int k_level = 0;            /* &level */
  111. struct descrip k_main;            /* &main */
  112.  
  113. word statsize = MaxStatSize;        /* size of static region */
  114. word statincr = MaxStatSize/4;        /* increment for static region */
  115. char *statbase = NULL;            /* start of static space */
  116. char *statend;                /* end of static space */
  117. char *statfree;                /* static space free pointer */
  118.  
  119. #ifndef MultiRegion
  120. word ssize = MaxStrSpace;        /* initial string space size (bytes) */
  121. char *strbase;                /* start of string space */
  122. char *strend;                /* end of string space */
  123. char *strfree;                /* string space free pointer */
  124. #endif                    /* MultiRegion */
  125. char *currend = NULL;            /* current end of memory region */
  126.  
  127. #ifndef MultiRegion
  128. word abrsize = MaxAbrSize;        /* initial size of allocated block
  129.                        region (bytes) */
  130. char *blkbase;                /* start of block region */
  131. char *blkend;                /* end of allocated blocks */
  132. char *blkfree;                /* block region free pointer */
  133. #endif                    /* MultiRegion */
  134.  
  135. #ifdef FixedRegions
  136. word qualsize = QualLstSize;        /* size of quallist for fixed regions */
  137. #endif                    /* FixedRegions */
  138.  
  139. uword statneed;                /* stated need for static space */
  140. uword strneed;                /* stated need for string space */
  141. uword blkneed;                /* stated need for block space */
  142.  
  143. uword stattotal = 0;            /* cumulative total static allocation */
  144. uword strtotal = 0;            /* cumulative total string allocation */
  145. uword blktotal = 0;            /* cumulative total block allocation */
  146.  
  147. int dodump;                /* if nonzero, core dump on error */
  148. int noerrbuf;                /* if nonzero, do not buffer stderr */
  149.  
  150. struct descrip k_current;        /* current expression stack pointer */
  151. struct descrip maps2;            /* second cached argument of map */
  152. struct descrip maps3;            /* third cached argument of map */
  153.  
  154. int k_errornumber = 0;            /* &errornumber */
  155. char *k_errortext = "";            /* &errortext */
  156. struct descrip k_errorvalue;        /* &errorvalue */
  157. int have_errval = 0;            /* &errorvalue has legal value */
  158. int t_errornumber = 0;            /* tentitive k_errornumber value */
  159. int t_have_val = 0;            /* tentitive have_errval flag */
  160. struct descrip t_errorvalue;        /* tentative k_errorvalue value */
  161.  
  162. struct b_coexpr *stklist;    /* base of co-expression block list */
  163. dptr argp = NULL;        /* argument pointer */
  164.  
  165. struct tend_desc *tend = NULL;  /* chain of tended descriptors */
  166.  
  167. #ifdef MultiRegion
  168. struct region rootstring, rootblock;
  169. #endif                    /* MultiRegion */
  170.  
  171. #ifdef MultiRegion
  172. struct region *curstring, *curblock;
  173. #endif                    /* MultiRegion */
  174.  
  175. #if COMPILER
  176. struct p_frame *pfp = NULL;    /* procedure frame pointer */
  177.  
  178. struct descrip *globals;     /* array of global variables */
  179. struct descrip *gnames;         /* array of names of global variables */
  180.  
  181. int debug_info;             /* flag: is debugging information available */
  182. int err_conv;             /* flag: is error conversion supported */
  183. int largeints;             /* flag: large integers are supported */
  184.  
  185. struct b_coexpr *mainhead;        /* &main */
  186.  
  187. #else                    /* COMPILER */
  188.  
  189. int debug_info=1;         /* flag: debugging information IS available */
  190. int err_conv=1;             /* flag: error conversion IS supported */
  191.  
  192. int op_tbl_sz = (sizeof(init_op_tbl) / sizeof(struct b_proc));
  193. struct pf_marker *pfp = NULL;    /* Procedure frame pointer */
  194.  
  195. #ifndef MaxHeader
  196. #define MaxHeader MaxHdr
  197. #endif                    /* MaxHeader */
  198.  
  199.  
  200. struct b_coexpr *mainhead;        /* &main */
  201.  
  202. char *code;                /* interpreter code buffer */
  203. word *records;                /* pointer to record procedure blocks */
  204. word *ftabp;                /* pointer to record/field table */
  205. dptr fnames, efnames;            /* pointer to field names */
  206. dptr globals, eglobals;            /* pointer to global variables */
  207. dptr gnames, egnames;            /* pointer to global variable names */
  208. dptr statics, estatics;            /* pointer to static variables */
  209. char *strcons;                /* pointer to string constant table */
  210. struct ipc_fname *filenms, *efilenms;    /* pointer to ipc/file name table */
  211. struct ipc_line *ilines, *elines;    /* pointer to ipc/line number table */
  212.  
  213. #ifdef TraceBack
  214. #endif                    /* TraceBack */
  215.  
  216.  
  217. #ifdef TallyOpt
  218. word tallybin[16];            /* counters for tallying */
  219. int tallyopt = 0;            /* want tally results output? */
  220. #endif                    /* TallyOpt */
  221.  
  222. #ifdef ExecImages
  223. int dumped = 0;                /* non-zero if reloaded from dump */
  224. #endif                    /* ExecImages */
  225.  
  226. word *stack;                /* Interpreter stack */
  227. word *stackend;             /* End of interpreter stack */
  228.  
  229.  
  230. #ifdef MultipleRuns
  231. extern word coexp_ser;
  232. extern word list_ser;
  233. extern word set_ser;
  234. extern word table_ser;
  235. extern int first_time;
  236. #endif                    /* MultipleRuns */
  237. #endif                    /* COMPILER */
  238.  
  239. #if !COMPILER
  240. /*
  241.  * Open the icode file and read the header.
  242.  * Used by icon_init() as well as MultiThread's loadicode()
  243.  */
  244. FILE *readhdr(name,hdr)
  245. char *name;
  246. struct header *hdr;
  247.    {
  248.    FILE *fname = NULL;
  249.    int n;
  250.  
  251.    if (!name)
  252.       error("no interpreter file supplied");
  253.  
  254.    /*
  255.     * Try adding the suffix if the file name doesn't end in it.
  256.     */
  257.    n = strlen(name);
  258.    if (n <= 4 || (strcmp(name+n-4,IcodeSuffix) != 0)
  259.    && strcmp(name+n-4,IcodeASuffix) != 0) {
  260.       char tname[100];
  261.       if (strlen(name) + 5 > 100)
  262.          error("icode file name too long");
  263.       strcpy(tname,name);
  264.  
  265. #if MVS
  266.    {
  267.       char *p;
  268.       if (p = index(name, '(')) {
  269.          tname[p-name] = '\0';
  270.       }
  271. #endif                    /* MVS */
  272.  
  273.       strcat(tname,IcodeSuffix);
  274.  
  275. #if MVS
  276.       if (p) strcat(tname,p);
  277.    }
  278. #endif                    /* MVS */
  279.  
  280. #if MSDOS || OS2
  281.       fname = pathOpen(tname,ReadBinary);    /* try to find path */
  282. #else                    /* MSDOS || OS2 */
  283.       fname = fopen(tname, ReadBinary);
  284. #endif                    /* MSDOS || OS2 */
  285.       }
  286.  
  287.    if (fname == NULL)                /* try the name as given */
  288.  
  289. #if MSDOS
  290.       fname = pathOpen(name, ReadBinary);
  291. #else                    /* MSDOS */
  292.       fname = fopen(name, ReadBinary);
  293. #endif                    /* MSDOS */
  294.  
  295.    if (fname == NULL)
  296.       error("cannot open interpreter file");
  297.  
  298.  
  299.    {
  300.    static char errmsg[] = "can't read interpreter file header";
  301.  
  302. #ifdef Header
  303.    if (fseek(fname, (long)MaxHeader, 0) == -1)
  304.       error(errmsg);
  305. #endif                    /* Header */
  306.  
  307.    if (fread((char *)hdr, sizeof(char), sizeof(*hdr), fname) != sizeof(*hdr))
  308.       error(errmsg);
  309.    }
  310.  
  311.  
  312.    return fname;
  313.    }
  314. #endif
  315.  
  316. /*
  317.  * icon_init - initialize memory and prepare for Icon execution.
  318.  */
  319.  
  320. #if COMPILER
  321. novalue init(name, trc_init)
  322. char *name;
  323. int trc_init;
  324. #else                    /* COMPILER */
  325. novalue icon_init(name)
  326. char *name;
  327. #endif                    /* COMPILER */
  328.  
  329.    {
  330.    int n;
  331. #if !COMPILER
  332.    struct header hdr;
  333.    FILE *fname = NULL;
  334.    word cbread, longread();
  335. #endif                    /* COMPILER */
  336.  
  337. #if COMPILER
  338. #ifdef MultiRegion
  339.    curstring = &rootstring;
  340.    curblock  = &rootblock;
  341.    rootstring.size = MaxStrSpace;
  342.    rootblock.size  = MaxAbrSize;
  343. #endif                    /* MultiRegion */
  344. #else                    /* COMPILER */
  345.  
  346.  
  347. #ifdef MultiRegion
  348.    curstring = &rootstring;
  349.    curblock  = &rootblock;
  350. #endif                    /* MultiRegion */
  351.  
  352. #ifdef MultiRegion
  353.    rootstring.size = MaxStrSpace;
  354.    rootblock.size  = MaxAbrSize;
  355. #endif                    /* MultiRegion */
  356. #endif                    /* COMPILER */
  357.  
  358. #if !COMPILER
  359.    op_tbl = (struct b_proc*)init_op_tbl;
  360. #endif                    /* !COMPILER */
  361.  
  362.    /*
  363.     * Catch floating-point traps and memory faults.
  364.     */
  365.  
  366. /*
  367.  * The following code is operating-system dependent [@init.02].  Set traps.
  368.  */
  369.  
  370. #if PORT
  371.    /* probably needs something */
  372. Deliberate Syntax Error
  373. #endif                    /* PORT */
  374.  
  375. #if AMIGA
  376.    signal(SIGFPE,fpetrap);
  377. #endif                    /* AMIGA */
  378.  
  379. #if ARM
  380.    signal(SIGFPE, (void (*)(int))fpetrap);
  381.    signal(SIGSEGV, (void (*)(int))segvtrap);
  382. #endif                    /* ARM */
  383.  
  384. #if ATARI_ST
  385. #endif                    /* ATARI_ST */
  386.  
  387. #if MACINTOSH
  388. #if MPW
  389.    /* This is equivalent to SIGFPE signal in the Standard Apple
  390.       Numeric Environment (SANE) */
  391.    {
  392.    environment e;
  393.    getenvironment(&e);
  394. #ifdef mc68881
  395.       e.FPCR |= CURUNDERFLOW|CUROVERFLOW|CURDIVBYZERO;
  396. #else                    /* mc68881 */
  397.       e |= UNDERFLOW|OVERFLOW|DIVBYZERO;
  398. #endif                    /* mc68881 */
  399.    setenvironment(e);
  400. #ifdef mc68881
  401.       {
  402.       static trapvector tv =
  403.          {fpetrap,fpetrap,fpetrap,fpetrap,fpetrap,fpetrap,fpetrap};
  404.       settrapvector(&tv);
  405.       }
  406. #else                    /* mc6881 */
  407.       sethaltvector((haltvector)fpetrap);
  408. #endif                    /* mc6881 */
  409.    }
  410. #endif                    /* MPW */
  411. #endif                    /* MACINTOSH */
  412.  
  413. #if MSDOS
  414. #if LATTICE || MICROSOFT || TURBO
  415.    signal(SIGFPE, fpetrap);
  416. #endif                    /* LATTICE || MICROSOFT || TURBO */
  417. #endif                    /* MSDOS */
  418.  
  419. #if MVS || VM
  420. #if SASC
  421.    cosignal(SIGFPE, fpetrap);           /* catch in all coprocs */
  422.    cosignal(SIGSEGV, segvtrap);
  423. #endif                    /* SASC */
  424. #endif                                  /* MVS || VM */
  425.  
  426. #if OS2
  427.    signal(SIGFPE, fpetrap);
  428.    signal(SIGSEGV, segvtrap);
  429. #endif                    /* OS2 */
  430.  
  431. #if UNIX || VMS
  432.    signal(SIGSEGV, segvtrap);
  433. #ifdef PYRAMID
  434.    {
  435.    struct sigvec a;
  436.  
  437.    a.sv_handler = fpetrap;
  438.    a.sv_mask = 0;
  439.    a.sv_onstack = 0;
  440.    sigvec(SIGFPE, &a, 0);
  441.    sigsetmask(1 << SIGFPE);
  442.    }
  443. #else                    /* PYRAMID */
  444.    signal(SIGFPE, fpetrap);
  445. #endif                    /* PYRAMID */
  446. #endif                    /* UNIX || VMS */
  447.  
  448. /*
  449.  * End of operating-system specific code.
  450.  */
  451.  
  452. #if !COMPILER
  453. #ifdef ExecImages
  454.    /*
  455.     * If reloading from a dumped out executable, skip most of init and
  456.     *  just set up the buffer for stderr and do the timing initializations.
  457.     */
  458.    if (dumped)
  459.        goto btinit;
  460. #endif                    /* ExecImages */
  461. #endif                    /* COMPILER */
  462.  
  463.    /*
  464.     * Initialize data that can't be initialized statically.
  465.     */
  466.  
  467.    datainit();
  468.  
  469. #if COMPILER
  470.    IntVal(kywd_trc) = trc_init;
  471. #endif                    /* COMPILER */
  472.  
  473. #if !COMPILER
  474.    fname = readhdr(name,&hdr);
  475.  
  476.    k_trace = hdr.trace;
  477.  
  478. #endif                    /* COMPILER */
  479.  
  480. #ifdef EnvVars
  481.    /*
  482.     * Examine the environment and make appropriate settings.    [[I?]]
  483.     */
  484.    envset();
  485. #endif                    /* EnvVars */
  486.  
  487.  
  488.    /*
  489.     * Convert stack sizes from words to bytes.
  490.     */
  491.  
  492. #ifndef SCO_XENIX
  493.    stksize *= WordSize;
  494.    mstksize *= WordSize;
  495. #else                    /* SCO_XENIX */
  496.    /*
  497.     * This is a work-around for bad generated code for *= (as above)
  498.     *  produced by the SCO XENIX C Compiler for the large memory model.
  499.     *  It relies on the fact that WordSize is 4.
  500.     */
  501.    stksize += stksize;
  502.    stksize += stksize;
  503.    mstksize += mstksize;
  504.    mstksize += mstksize;
  505. #endif                    /* SCO_XENIX */
  506.  
  507. #if IntBits == 16
  508.    if (mstksize > MaxBlock)
  509.       fatalerr(316, NULL);
  510.    if (stksize > MaxBlock)
  511.       fatalerr(318, NULL);
  512. #endif                    /* IntBits == 16 */
  513.  
  514.    /*
  515.     * Allocate memory for various regions.
  516.     */
  517. #if COMPILER
  518.    initalloc();
  519. #else                    /* COMPILER */
  520.    initalloc(hdr.hsize);
  521. #endif                    /* COMPILER */
  522.  
  523. #if !COMPILER
  524.    /*
  525.     * Establish pointers to icode data regions.        [[I?]]
  526.     */
  527.  
  528.    records = (word *)(code + hdr.records);
  529.    ftabp = (word *)(code + hdr.ftab);
  530.    fnames = (dptr)(code + hdr.fnames);
  531.    globals = efnames = (dptr)(code + hdr.globals);
  532.    gnames = eglobals = (dptr)(code + hdr.gnames);
  533.    statics = egnames = (dptr)(code + hdr.statics);
  534.    estatics = (dptr)(code + hdr.filenms);
  535.    n_globals = eglobals - globals;
  536.    n_statics = estatics - statics;
  537.    filenms = (struct ipc_fname *)estatics;
  538.    efilenms = (struct ipc_fname *)(code + hdr.linenums);
  539.    ilines = (struct ipc_line *)efilenms;
  540.    elines = (struct ipc_line *)(code + hdr.strcons);
  541.    strcons = (char *)elines;
  542. #endif                    /* COMPILER */
  543.  
  544.    /*
  545.     * Allocate stack and initialize &main.
  546.     */
  547.  
  548. #if COMPILER
  549.    mainhead = (struct b_coexpr *)malloc((msize)sizeof(struct b_coexpr));
  550. #else                    /* COMPILER */
  551.    stack = (word *)malloc((msize)mstksize);
  552.    mainhead = (struct b_coexpr *)stack;
  553.  
  554. #ifndef FixedRegions
  555.    stattotal -= mstksize;    /* keep &allocations consistent with &storage */
  556. #endif                    /* FixedRegions */
  557. #endif                    /* COMPILER */
  558.  
  559.    if (mainhead == NULL)
  560. #if COMPILER
  561.       err_msg(305, NULL);
  562. #else                    /* COMPILER */
  563.       fatalerr(303, NULL);
  564. #endif                    /* COMPILER */
  565.  
  566.    mainhead->title = T_Coexpr;
  567.    mainhead->id = 1;
  568.    mainhead->size = 1;            /* pretend main() does an activation */
  569.    mainhead->nextstk = NULL;
  570.    mainhead->es_tend = NULL;
  571.    mainhead->freshblk = nulldesc;    /* &main has no refresh block. */
  572.                     /*  This really is a bug. */
  573. #if COMPILER
  574.    mainhead->file_name = "";
  575.    mainhead->line_num = 0;
  576. #endif                    /* COMPILER */
  577.  
  578. #ifdef Coexpr
  579.    Protect(mainhead->es_actstk = alcactiv(), fatalerr(0,NULL));
  580.    pushact(mainhead, mainhead);
  581. #endif                    /* Coexpr */
  582.  
  583.    /*
  584.     * Point &main at the co-expression block for the main procedure and set
  585.     *  k_current, the pointer to the current co-expression, to &main.
  586.     */
  587.    k_main.dword = D_Coexpr;
  588.    BlkLoc(k_main) = (union block *) mainhead;
  589.    k_current = k_main;
  590.    
  591. #if !COMPILER
  592.    /*
  593.     * Read the interpretable code and data into memory.
  594.     */
  595.  
  596.    if ((cbread = longread(code, sizeof(char), (long)hdr.hsize, fname)) !=
  597.       hdr.hsize) {
  598.       fprintf(stderr,"Tried to read %ld bytes of code, got %ld\n",
  599.     (long)hdr.hsize,(long)cbread);
  600.       error("can't read interpreter code");
  601.       }
  602.    fclose(fname);
  603.  
  604. /*
  605.  * Make sure the version number of the icode matches the interpreter version.
  606.  */
  607.  
  608.    if (strcmp((char *)hdr.config,IVersion)) {
  609.       fprintf(stderr,"icode version mismatch\n");
  610.       fprintf(stderr,"\ticode version: %s\n",(char *)hdr.config);
  611.       fprintf(stderr,"\texpected version: %s\n",IVersion);
  612.       error("cannot run");
  613.       }
  614. #endif                    /* !COMPILER */
  615.  
  616.    /*
  617.     * Initialize the event monitoring system, if configured.
  618.     */
  619.  
  620. #ifdef MemMon
  621. #if COMPILER
  622.    EVInit(name,NULL);
  623. #else                    /* COMPILER */
  624.    EVInit(name,monfname);
  625. #endif                    /* COMPILER */
  626. #endif                    /* MemMon */
  627.  
  628. #if !COMPILER
  629.    /*
  630.     * Resolve references from icode to run-time system.
  631.     */
  632.    resolve();
  633. #endif                    /* COMPILER */
  634.  
  635. #ifdef MemMon
  636.    EVSetup();
  637. #endif                    /* MemMon */
  638.  
  639. #if !COMPILER
  640. #ifdef ExecImages
  641. btinit:
  642. #endif                    /* ExecImages */
  643. #endif                    /* COMPILER */
  644.  
  645. /*
  646.  * The following code is operating-system dependent [@init.03].  Allocate and
  647.  *  assign a buffer to stderr if possible.
  648.  */
  649.  
  650. #if PORT
  651.    /* probably nothing */
  652. Deliberate Syntax Error
  653. #endif                    /* PORT */
  654.  
  655. #if AMIGA || MVS || VM
  656.    /* not done */
  657. #endif                    /* AMIGA */
  658.  
  659. #if ARM || ATARI_ST || MACINTOSH || UNIX || OS2 || VMS
  660.  
  661.  
  662.    if (noerrbuf)
  663.       setbuf(stderr, NULL);
  664.    else {
  665.       char *buf;
  666.       
  667.       buf = (char *)malloc((msize)BUFSIZ);
  668.       if (buf == NULL)
  669.         fatalerr(305, NULL);
  670.       setbuf(stderr, buf);
  671.       }
  672. #endif                    /* ARM || ATARI_ST || MACINTOSH ... */
  673.  
  674. #if MSDOS
  675. #if !HIGHC_386
  676.    if (noerrbuf)
  677.       setbuf(stderr, NULL);
  678.    else {
  679.       char *buf;
  680.       
  681.       buf = (char *)malloc((msize)BUFSIZ);
  682.       if (buf == NULL)
  683.         fatalerr(305, NULL);
  684.       setbuf(stderr, buf);
  685.       }
  686. #endif                    /* !HIGHC_386 */
  687. #endif                    /* MSDOS */
  688.  
  689. /*
  690.  * End of operating-system specific code.
  691.  */
  692.  
  693.  
  694.    /*
  695.     * Start timing execution.
  696.     */
  697.  
  698.    millisec();
  699.    }
  700.  
  701. /*
  702.  * Service routines related to getting things started.
  703.  */
  704.  
  705.  
  706. #ifdef EnvVars
  707. /*
  708.  * Check for environment variables that Icon uses and set system
  709.  *  values as is appropriate.
  710.  */
  711. novalue envset()
  712.    {
  713.    register char *p;
  714.  
  715.    if ((p = getenv("NOERRBUF")) != NULL)
  716.       noerrbuf++;
  717.    env_int(TRACE, &k_trace, 0, (uword)0);
  718.    env_int(COEXPSIZE, &stksize, 1, (uword)MaxUnsigned);
  719.    env_int(STRSIZE, &ssize, 1, (uword)MaxBlock);
  720.    env_int(HEAPSIZE, &abrsize, 1, (uword)MaxBlock);
  721.    env_int(BLOCKSIZE, &abrsize, 1, (uword)MaxBlock);    /* synonym */
  722.    env_int(BLKSIZE, &abrsize, 1, (uword)MaxBlock);    /* synonym */
  723.    env_int(STATSIZE, &statsize, 1, (uword)MaxBlock);
  724.    env_int(STATINCR, &statincr, 1, (uword)MaxBlock);
  725.    env_int(MSTKSIZE, &mstksize, 1, (uword)MaxUnsigned);
  726.  
  727. #ifdef FixedRegions
  728.    env_int(QLSIZE, &qualsize, 1, (uword)MaxBlock);
  729. #endif                    /* FixedRegions */
  730.  
  731. /*
  732.  * The following code is operating-system dependent [@init.04].  Check any
  733.  *  system-dependent environment variables.
  734.  */
  735.  
  736. #if PORT
  737.    /* nothing to do */
  738. Deliberate Syntax Error
  739. #endif                    /* PORT */
  740.  
  741. #if AMIGA
  742.    if ((p = getenv("CHECKBREAK")) != NULL)
  743.       chkbreak++;
  744. #endif                    /* AMIGA */
  745.  
  746. #if ARM || ATARI_ST || MACINTOSH || MSDOS || MVS || OS2 || UNIX || VM
  747.    /* nothing to do */
  748. #endif                    /* ARM || ATARI_ST || ... */
  749.  
  750. #if VMS
  751.    {
  752.       extern word memsize;
  753.       env_int("MAXMEM", &memsize, 1, MaxBlock);
  754.    }
  755. #endif                    /* VMS */
  756.  
  757. /*
  758.  * End of operating-system specific code.
  759.  */
  760.  
  761.    if ((p = getenv(ICONCORE)) != NULL && *p != '\0') {
  762.  
  763. /*
  764.  * The following code is operating-system dependent [@init.05].  Set trap to
  765.  *  give dump on abnormal termination if ICONCORE is set.
  766.  */
  767.  
  768. #if PORT
  769.    /* can't handle */
  770. Deliberate Syntax Error
  771. #endif                    /* PORT */
  772.  
  773. #if AMIGA || ATARI_ST || MACINTOSH
  774.    /* can't handle */
  775. #endif                    /* AMIGA || ATARI_ST || ... */
  776.  
  777. #if ARM || OS2
  778.       signal(SIGSEGV, SIG_DFL);
  779.       signal(SIGFPE, SIG_DFL);
  780. #endif                    /* ARM || OS2 */
  781.  
  782. #if MSDOS
  783. #if LATTICE || TURBO
  784.       signal(SIGFPE, SIG_DFL);
  785. #endif                    /* LATTICE || TURBO */
  786. #endif                    /* MSDOS */
  787.  
  788. #if MVS || VM
  789.       /* Really nothing to do. */
  790. #endif                    /* MVS || VM */
  791.  
  792. #if UNIX || VMS
  793.       signal(SIGSEGV, SIG_DFL);
  794. #endif                    /* UNIX || VMS */
  795.  
  796. /*
  797.  * End of operating-system specific code.
  798.  */
  799.       dodump++;
  800.       }
  801.    }
  802.  
  803. /*
  804.  * env_err - print an error mesage about the value of an environment
  805.  *  variable.
  806.  */
  807. static novalue env_err(msg, name, val)
  808. char *msg;
  809. char *name;
  810. char *val;
  811. {
  812.    char msg_buf[100];
  813.  
  814.    strncpy(msg_buf, msg, 99);
  815.    strncat(msg_buf, ": ", 99 - (int)strlen(msg_buf));
  816.    strncat(msg_buf, name, 99 - (int)strlen(msg_buf));
  817.    strncat(msg_buf, "=", 99 - (int)strlen(msg_buf));
  818.    strncat(msg_buf, val, 99 - (int)strlen(msg_buf));
  819.    error(msg_buf);
  820. }
  821.  
  822. /*
  823.  * env_int - get the value of an integer-valued environment variable.
  824.  */
  825. novalue env_int(name, variable, non_neg, limit)
  826. char *name;
  827. word *variable;
  828. int non_neg;
  829. uword limit;
  830. {
  831.    char *value;
  832.    char *s;
  833.    register uword n = 0;
  834.    register uword d;
  835.    int sign = 1;
  836.  
  837.    if ((value = getenv(name)) == NULL || *value == '\0')
  838.       return;
  839.  
  840.    s = value;
  841.    if (*s == '-') {
  842.       if (non_neg)
  843.          env_err("environment variable out of range", name, value);
  844.       sign = -1;
  845.       ++s;
  846.       }
  847.    else if (*s == '+')
  848.       ++s;
  849.    while (isdigit(*s)) {
  850.       d = *s++ - '0';
  851.       /*
  852.        * See if 10 * n + d > limit, but do it so there can be no overflow.
  853.        */
  854.       if ((d > (uword)(limit / 10 - n) * 10 + limit % 10) && (limit > 0))
  855.      env_err("environment variable out of range", name, value);
  856.       n = n * 10 + d;
  857.       }
  858.    if (*s != '\0')
  859.       env_err("environment variable not numeric", name, value);
  860.    *variable = sign * n;
  861. }
  862. #endif                    /* EnvVars */
  863.  
  864. /*
  865.  * Termination routines.
  866.  */
  867.  
  868. /*
  869.  * Produce run-time error 204 on floating-point traps.
  870.  */
  871.  
  872. novalue fpetrap()
  873.    {
  874.    fatalerr(204, NULL);
  875.    }
  876.  
  877. /*
  878.  * Produce run-time error 320 on ^C interrupts. Not used at present,
  879.  *  since malfunction may occur during traceback.
  880.  */
  881. novalue inttrap()
  882.    {
  883.    fatalerr(320, NULL);
  884.    }
  885.  
  886. /*
  887.  * Produce run-time error 302 on segmentation faults.
  888.  */
  889. novalue segvtrap()
  890.    {
  891.    fatalerr(302, NULL);
  892.    }
  893.  
  894. /*
  895.  * error - print error message s; used only in startup code.
  896.  */
  897. novalue error(s)
  898. char *s;
  899.    {
  900.  
  901.  
  902.    fprintf(stderr, "error in startup code\n%s\n", s);
  903.  
  904.    fflush(stderr);
  905.    if (dodump)
  906.       abort();
  907.    c_exit(ErrorExit);
  908.    }
  909.  
  910. /*
  911.  * syserr - print s as a system error.
  912.  */
  913. novalue syserr(s)
  914. char *s;
  915.    {
  916.  
  917.    
  918. #if COMPILER
  919.    if (pfp != 0  && line_info)
  920.       fprintf(stderr, "System error at line %d in %s\n%s\n",
  921.          line_num, file_name, s);
  922. #else                    /* COMPILER */
  923.    if (pfp != 0)
  924.       fprintf(stderr, "System error at line %ld in %s\n%s\n",
  925.          (long)findline(ipc.opnd), findfile(ipc.opnd), s);
  926. #endif                    /* COMPILER */
  927.  
  928.    else
  929.       fprintf(stderr, "System error in startup code\n%s\n", s);
  930.  
  931.    fflush(stderr);
  932.    if (dodump)
  933.       abort();
  934.    c_exit(ErrorExit);
  935.    }
  936.  
  937. /*
  938.  * c_exit(i) - flush all buffers and exit with status i.
  939.  */
  940. novalue c_exit(i)
  941. int i;
  942. {
  943. #ifdef EventMon
  944.    EVVal((word)i,E_Exit);
  945. #endif                    /* EventMon */
  946.  
  947. #ifdef MemMon
  948.    EVTerm(0, i == NormalExit ? "Normal Exit" : "Error Exit");
  949. #endif                    /* MemMon */
  950.  
  951. #ifdef TallyOpt
  952.    {
  953.    int j;
  954.  
  955.    if (tallyopt) {
  956.       fprintf(stderr,"tallies: ");
  957.       for (j=0; j<16; j++)
  958.          fprintf(stderr," %ld", (long)tallybin[j]);
  959.          fprintf(stderr,"\n");
  960.          }
  961.       }
  962. #endif                    /* TallyOpt */
  963.  
  964.  
  965. #ifdef MultipleRuns
  966.    /*
  967.     * Free allocated memory so application can continue.
  968.     */
  969.  
  970.    xmfree();
  971. #endif                    /* MultipleRuns */
  972.  
  973. #if TURBO
  974.    flushall();
  975.    _exit(i);
  976. #else                    /* TURBO */
  977.    exit(i);
  978. #endif                    /* TURBO */
  979.  
  980. }
  981.  
  982. /*
  983.  * err() is called if an erroneous situation occurs in the virtual
  984.  *  machine code.  It is typed as int to avoid declaration problems
  985.  *  elsewhere.
  986.  */
  987. int err()
  988. {
  989.    syserr("call to 'err'\n");
  990.    return 1;        /* unreachable; make compilers happy */
  991. }
  992.  
  993. /*
  994.  * fatalerr - disable error conversion and call run-time error routine.
  995.  */
  996. novalue fatalerr(n, v)
  997. int n;
  998. dptr v;
  999.    {
  1000.    IntVal(kywd_err) = 0;
  1001.    err_msg(n, v);
  1002.    }
  1003.  
  1004. /*
  1005.  * pstrnmcmp - compare names in two pstrnm structs; used for qsort.
  1006.  */
  1007. int pstrnmcmp(a,b)
  1008. struct pstrnm *a, *b;
  1009. {
  1010.   return strcmp(a->pstrep, b->pstrep);
  1011. }
  1012.  
  1013. /*
  1014.  * datainit - initialize some global variables.
  1015.  */
  1016. novalue datainit()
  1017.    {
  1018.  
  1019.    /*
  1020.     * Initializations that cannot be performed statically (at least for
  1021.     * some compilers).                    [[I?]]
  1022.     */
  1023.  
  1024.    k_errout.fd = stderr;
  1025.    StrLen(k_errout.fname) = 7;
  1026.    StrLoc(k_errout.fname) = "&errout";
  1027.    k_errout.status = Fs_Write;
  1028.  
  1029.    k_input.fd = stdin;
  1030.    StrLen(k_input.fname) = 6;
  1031.    StrLoc(k_input.fname) = "&input";
  1032.    k_input.status = Fs_Read;
  1033.  
  1034.    k_output.fd = stdout;
  1035.    StrLen(k_output.fname) = 7;
  1036.    StrLoc(k_output.fname) = "&output";
  1037.    k_output.status = Fs_Write;
  1038.  
  1039.    IntVal(kywd_pos) = 1;
  1040.    IntVal(kywd_ran) = 0;
  1041.    StrLen(k_subject) = 0;
  1042.    StrLoc(k_subject) = "";
  1043.  
  1044.  
  1045.    StrLen(blank) = 1;
  1046.    StrLoc(blank) = " ";
  1047.    StrLen(emptystr) = 0;
  1048.    StrLoc(emptystr) = "";
  1049.    BlkLoc(nullptr) = (union block *)NULL;
  1050.    BlkLoc(errout) = (union block *) &k_errout;
  1051.    BlkLoc(input) = (union block *) &k_input;
  1052.    StrLen(lcase) = 26;
  1053.    StrLoc(lcase) = "abcdefghijklmnopqrstuvwxyz";
  1054.    StrLen(letr) = 1;
  1055.    StrLoc(letr) = "r";
  1056.    IntVal(nulldesc) = 0;
  1057.    k_errorvalue = nulldesc;
  1058.    IntVal(onedesc) = 1;
  1059.    StrLen(ucase) = 26;
  1060.    StrLoc(ucase) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  1061.    IntVal(zerodesc) = 0;
  1062.  
  1063.    maps2 = nulldesc;
  1064.    maps3 = nulldesc;
  1065.  
  1066. #if !COMPILER
  1067. #if TURBO
  1068.    qsort(pntab,pnsize,sizeof(struct pstrnm),
  1069.      (int(*)(const void *, const void *))pstrnmcmp);
  1070. #else                    /* TURBO */
  1071.    qsort((char *)pntab,pnsize,sizeof(struct pstrnm),pstrnmcmp);
  1072. #endif                    /* TURBO */
  1073.  
  1074. #ifdef MultipleRuns
  1075.    /*
  1076.     * Initializations required for repeated program runs
  1077.     */
  1078.                     /* In this module:    */
  1079.    k_level = 0;                /* &level */
  1080.    k_errornumber = 0;            /* &errornumber */
  1081.    k_errortext = "";            /* &errortext */
  1082.    statsize = MaxStatSize;        /* size of static region */
  1083.    statincr = MaxStatSize/4;        /* increment for static region */
  1084.    statbase = NULL;            /* start of static space */
  1085.    currend = NULL;            /* current end of memory region */
  1086.  
  1087.  
  1088.    mstksize = MStackSize;        /* initial size of main stack */
  1089.    stksize = StackSize;            /* co-expression stack size */
  1090.    ssize = MaxStrSpace;            /* initial string space size (bytes) */
  1091.    abrsize = MaxAbrSize;        /* initial size of allocated block
  1092.                          region (bytes) */                                    
  1093. #ifdef FixedRegions
  1094.    qualsize = QualLstSize;        /* size of quallist for fixed regions */
  1095. #endif                    /* FixedRegions */
  1096.  
  1097.    dodump = 0;                /* produce dump on error */
  1098.  
  1099. #ifdef ExecImages
  1100.    dumped = 0;                /* This is a dumped image. */
  1101. #endif                    /* ExecImages */
  1102.  
  1103.                     /* In module interp.c:    */
  1104.    pfp = 0;                /* Procedure frame pointer */
  1105.    sp = NULL;                /* Stack pointer */
  1106.  
  1107.  
  1108.                     /* In module rmemmgt.c:    */
  1109.    coexp_ser = 2;
  1110.    list_ser = 1;
  1111.    set_ser = 1;
  1112.    table_ser = 1;
  1113.  
  1114.    coll_stat = 0;
  1115.    coll_str = 0;
  1116.    coll_blk = 0;
  1117.    coll_tot = 0;
  1118.  
  1119.                     /* In module time.c: */
  1120.    first_time = 1;
  1121.    
  1122.  
  1123. #endif                    /* MultipleRuns */
  1124. #endif                    /* COMPILER */
  1125.  
  1126.    }
  1127.  
  1128.